perm filename METER.F4[P11,LCS] blob
sn#570610 filedate 1981-03-08 generic text, type T, neo UTF8
00100 SUBROUTINE METER
00200 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(17),T,Z,H/STF/RSTFAC(8),RSTJ2
00300 1 /POSI/STFF(0/7),JJ2,POS
00400 EQUIVALENCE (R4,RJQ(2)),(J4,JQ(2)),(J5,JQ(3)),(J6,JQ(4))
00500 1,(R6,RJQ(4)),(R5,RJQ(3)),(R3,RJQ(1)),(R7,RJQ(5)),
00600 1 (R8,RJQ(6)),(R10,RJQ(8)),(R11,RJQ(9)),(R9,RJQ(7))
00700 1,(RX3,RJQ(20)),(J3,JQ(1))
00800 IF(R7.NE.0)GO TO 10
00900 R7=1.25
01000 GO TO 11
01100 10 R7=R7*1.25
01200 11 R4=R4-2.21
01300 KS=0
01400 C FLAG FOR DOUBLE METERS 3/4+5/8 ETC.
01500 IF(R8.EQ.0)GO TO 1
01600 RD8=R8
01700 C SAVE VARIOUS PARAMETERS
01800 R8=0
01900 RD7=R7
02000 C SIZE
02100 RD3=R3
02200 CENTD=CENTR
02300 KS=-1
02400 C SET DOUBLE METER FLAG
02500 RD4=R4
02600 POSP=12.
02700 C POS FOR PLUS SIGN
02800 POSM=19.
02900 C POS FOR 2ND METER
03000 IF(J6.LT.10)GO TO 6
03100 C INCREASE SPACE FOR DOUBLE DIGIT NUMBERS
03200 POSP=17.
03300 POSM=24.
03400 6 IF(R10.EQ.0)R10=1
03500 IF(R11.EQ.0)R11=R10
03600 C R10 MOVES +, R11 MOVES 2ND METER
03700 POSP=POSP*R10
03800 C P10, P11 CAN CHANGE SPREAD BETWEEN METERS
03900 POSM=POSM*R11
04000 R11=0
04100 C R11 MUST =0 FOR OTHER PLACES
04200 1 JZ=J3
04300 IF(R5.NE.0)GO TO 102
04400 C MOVEM 02,JZ# ; 25300 RY=R4+8.*.COMM.+=8
04500 R7=R7+.25
04600 C INCREASE SIZE(1.25) FOR SINGLE METER.
04700 R4=R4+.94
04800 102 R4=R4+R7*8.
04900 C ADD 8 TO RAISE IT
05000 RY=R4
05100 C HEIGHT
05200 RW=R6
05300 C BOTTOM NUM
05400 R6=R7
05500 RR6=R6
05600 C SIZE FOR BDR40 -- OR =1
05700 M=0
05800 2 R7=0
05900 IF(R5.EQ.0)GO TO 103
06000 IF(R5.LT.90.)GO TO 3
06100 M=-1
06200 C IF TOP NUM.=0 SKIP OVER
06300 C 99 AS METER = 'C' 98=ALLA BREVE (CUT TIME)
06400 IF(R5.NE.98)GO TO 4
06500 C NEXT FOR LINE THROUGH C.
06600 RA=POS
06700 R6=RX3
06800 C TO LINE UP WITH R3
06900 J10=2
07000 C FOR THICK LINE
07100 R4=R4-3.8
07200 R5=R4+5.6
07300 J7=0
07400 R8=0
07500 CALL ITMSUB
07600 POS=RA
07700 R4=RY
07800 R6=RR6
07900 C GET BACK THE RIGHT PARAMS.
08000 4 R5=9999.
08100 C TO CENTER 12S AND 16S
08200 3 CALL MAKNUM(R5)
08300 IF(M.LT.0)GO TO 5
08400 103 M=-1
08500 C STICK AROUND FOR BOTTOM NUM
08600 R6=RR6
08700 R4=RY+.9-4.*RR6
08800 R5=RW
08900 C GET BOTTOM NUM
09000 J3=JZ
09100 R8=0
09200 IF(R5.GT.0)GO TO 2
09300 5 IF(KS.EQ.0)RETURN
09400 C SKIP IF DOUBLE METER
09500 KS=0
09600 R4=RD4+4.
09700 C GET BACK VERT POS.
09800 C ADD FOR + SIGN
09900 RX=R9
10000 R6=RD7
10100 C SIZE
10200 R7=RD7
10300 R9=0
10400 R8=0
10500 JA=9
10600 J5=14
10700 RJ=RSTJ2*RD7
10800 CENTR=CENTD+36.*RJ
10900 JZ=JZ+POSM*RJ
11000 J3=JZ
11100 R3=RD3+POSP*RJ
11200 C MOVE TO RIGHT 25 BASIC NOTCHES
11300 C SHIFT + 10 NOTCHES TO RIGHT OF ORIG.
11400 CALL NOTWRT
11500 R4=RD4
11600 C GET BACK BASIC R4
11700 C PUT RD8 AND RX INTO R5 AND R6
11800 R5=RD8
11900 R6=RX
12000 R7=RD7
12100 C GET BACK SIZE
12200 X=20.
12300 C SHIFT MORE TO RIGHT
12400 C ADD MORE SPACE IF BOT. # >10
12500 IF(RX.GE.10.)X=25.
12600 JZ=JZ+X*RJ
12700 J3=JZ
12800 C NEW POS IN J3
12900 GO TO 1
13000 END